home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / T-COMAL Today / (k)t2.d64 / rotpac.l < prev    next >
Text File  |  2007-02-28  |  2KB  |  62 lines
  1. 9000 // ROTPAC WHICH CONTAINS
  2. 9010 //
  3. 9020 // ANGLET
  4. 9030 // DCTOEP
  5. 9040 // EPTODC
  6. 9050 //
  7. 9060 PROC ANGLET(REF A,REF AX,REF D(,)) CLOSED
  8. 9070   CA:=COS(A)
  9. 9080   SA:=SIN(A)
  10. 9090   I1:=(AX-1) MOD 3+1
  11. 9100   I2:=(AX) MOD 3+1
  12. 9110   I3:=(AX+1) MOD 3+1
  13. 9120   D(I1,I1):=1
  14. 9130   D(I1,I2):=0
  15. 9140   D(I1,I3):=0
  16. 9150   D(I2,I1):=0
  17. 9160   D(I2,I2):=CA
  18. 9170   D(I2,I3):=SA
  19. 9180   D(I3,I1):=0
  20. 9190   D(I3,I2):=-SA
  21. 9200   D(I3,I3):=CA
  22. 9210 ENDPROC ANGLET
  23. 9220 //
  24. 9230 PROC DCTOEP(REF D(,),REF EP()) CLOSED
  25. 9240   LIMIT:=1E-04
  26. 9250   TRD:=TRACE(D)
  27. 9260   SQT:=SQR(1+TRD)
  28. 9270   IF SQT<LIMIT THEN PRINT "EP(4) APPROX. ZERO",CHR$(13),CHR$(13)
  29. 9280   EP(4):=SQT
  30. 9290   E1:=D(2,3)-D(3,2)
  31. 9300   E2:=D(3,1)-D(1,3)
  32. 9310   E3:=D(1,2)-D(2,1)
  33. 9320   IF ABS(SQT)>.2 THEN
  34. 9330     EP(1):=E1/SQT
  35. 9340     EP(2):=E2/SQT
  36. 9350     EP(3):=E3/SQT
  37. 9360   ELSE 
  38. 9370     EP(1):=SGN(E1)*SQR(ABS(2*D(1,1)+1-TRD))
  39. 9380     EP(2):=SGN(E2)*SQR(ABS(2*D(2,2)+1-TRD))
  40. 9390     EP(3):=SGN(E3)*SQR(ABS(2*D(3,3)+1-TRD))
  41. 9400   ENDIF 
  42. 9410   E:=SQR(EP(1)^2+EP(2)^2+EP(3)^2+EP(4)^2)
  43. 9420   FOR I:=1 TO 4 DO
  44. 9430     EP(I):=2*EP(I)/E
  45. 9440   ENDFOR I
  46. 9450 ENDPROC DCTOEP
  47. 9460 //
  48. 9470 PROC EPTODC(REF EP(),REF D(,)) CLOSED
  49. 9480   E:=EP(4)
  50. 9490   E2:=E^2
  51. 9500   D(1,1):=.5*(EP(1)^2+E2)-1
  52. 9510   D(2,2):=.5*(EP(2)^2+E2)-1
  53. 9520   D(3,3):=.5*(EP(3)^2+E2)-1
  54. 9530   D(1,2):=.5*(EP(2)*EP(1)+EP(3)*E)
  55. 9540   D(1,3):=.5*(EP(3)*EP(1)-EP(2)*E)
  56. 9550   D(2,1):=.5*(EP(1)*EP(2)-EP(3)*E)
  57. 9560   D(2,3):=.5*(EP(3)*EP(2)+EP(1)*E)
  58. 9570   D(3,1):=.5*(EP(1)*EP(3)+EP(2)*E)
  59. 9580   D(3,2):=.5*(EP(2)*EP(3)-EP(1)*E)
  60. 9590 ENDPROC EPTODC
  61. 9600 //
  62.